perm filename NEWEXP[4,LMM] blob sn#040791 filedate 1973-05-08 generic text, type T, neo UTF8

(DEFPROP NEWEXPFNS
 (NEWEXPFNS EXPLAINGENMOL
	    PRINCL
	    EXPLAINMOLECULES
	    EXPLAINRINGS
	    EXPLAINNOFV-RINGS
	    EXPLAINVL
	    VALENTNODE
	    EXPLAINCATALOG
	    EXPLAINNOLOOPEDRINGS
	    EXPLAINSTRUCTURESWITHATOMS
	    EXPLAINRINGSKELETONS
	    EXPLAINATTACHFVS
	    EXPLAINATTACHBIVALENTS
	    EXPLAINATTACHBIVS&LOOPS
	    EXPLAINPERMRADS)
VALUE)

(DEFPROP EXPLAINGENMOL
 (LAMBDA (CL) (BOX (PRINCL CL)))
EXPR)

(DEFPROP PRINCL
 (LAMBDA(CL)
  (PROG	(BIGLIST RSLT)
	(NILL COLLECT A LINE OF TEXT (WITH POSSIBLE DOWN ARROWS))
	(SETQ RSLT
	      (FOR NEW
		   X
		   IN
		   CL
		   AS
		   NEW
		   NUMITEMS
		   IS
		   (CDR X)
		   AS
		   NEW
		   ITEM
		   IS
		   (COND ((ATOM (CAR X)) (CAR X))
			 ((AND (ATOM (CAAR X)) (NOT (CDAR X))) (CAAR X))
			 ((EQ (CAAR X) (QUOTE VALENTNODE)) (CAR X))
			 ((AND (ATOM (CAAR X)) (GET (CAAR X) (QUOTE VALENCE)))
			  (HELP HERE)
			  (CONCAT (CAAR X) (PRINCL2 (CDAR X))))
			 (T (SETQ BIGLIST (CONS X BIGLIST)) NIL))
		   WHEN
		   ITEM
		   NCONC
		   (CONS ITEM (COND ((LESSP NUMITEMS 2.) NIL) (T (LIST DOWNVEC NUMITEMS UPVEC))))))
	(RETURN
	 (COND ((NULL BIGLIST) (OUTTEXT RSLT))
	       (T (EXPLAINLIST (COND (RSLT (CONS RSLT (CLEXPAND BIGLIST))) (T (CLEXPAND BIGLIST)))))))))
EXPR)

(DEFPROP EXPLAINMOLECULES
 (LAMBDA (CL U) (BOX (PRINCL (CONS (CONS (QUOTE U) U) CL))))
EXPR)

(DEFPROP EXPLAINRINGS
 (LAMBDA(U CL)
  (COND	((EQUAL (CLCOUNT CL) 2.) (SETQ CL (CLEXPAND CL)) (EXPLAINMULTBOND (CAR CL) (ADD1 U) (CADR CL)))
	(T (CURLYCIRCLE (PRINCL (CONS (CONS (QUOTE U) U) CL))))))
EXPR)

(DEFPROP EXPLAINNOFV-RINGS
 (LAMBDA (VL) (CURLYCIRCLE (EXPLAINVL VL 2.)))
EXPR)

(DEFPROP EXPLAINVL
 (LAMBDA(VL START)
  (PRINCL (FOR NEW X IN VL AS NEW I := (START INFINITY) WHEN (NOT (ZEROP X)) XLIST (CONS (VALENTNODE I) X))))
EXPR)

(DEFPROP VALENTNODE
 (LAMBDA (N) (CONS (QUOTE VALENTNODE) N))
EXPR)

(DEFPROP EXPLAINCATALOG
 (LAMBDA (TVL) (EXPLAINNOLOOPEDRINGS (CONS 0. TVL)))
EXPR)

(DEFPROP EXPLAINNOLOOPEDRINGS
 (LAMBDA (VL) (CIRCLE (EXPLAINVL VL)))
EXPR)

(DEFPROP EXPLAINSTRUCTURESWITHATOMS
 (LAMBDA (CLL STRUC) (ABOVE (PRINCL (FOR NEW X IN CLL APPEND X)) (EXPLAIN STRUC)))
EXPR)

(DEFPROP EXPLAINRINGSKELETONS
 (LAMBDA(FV VL)
  (CURLYCIRCLE
   (PRINCL
    (FOR NEW
	 X
	 IN
	 VL
	 AS
	 NEW
	 I
	 :=
	 (2. INFINITY)
	 WHEN
	 (NOT (ZEROP X))
	 LIST
	 FIRST
	 (COND (FV (LIST (CONS FREEVALENCE FV))) (T NIL))
	 (CONS (VALENTNODE I) X)))))
EXPR)

(DEFPROP EXPLAINATTACHFVS
 (LAMBDA(FVL STRUC)
  (ABOVE (PRINCL
	  (FOR NEW
	       FVR
	       IN
	       FVL
	       AS
	       NEW
	       VALNODE
	       :=
	       (2. INFINITY)
	       FOR
	       NEW
	       FVI
	       IN
	       FVR
	       AS
	       NEW
	       NUMFV
	       :=
	       (1. INFINITY)
	       WHEN
	       (NOT (ZEROP FVI))
	       LIST
	       (CONS (FVVALENTNODE VALNODE NUMFV) FVI)))
	 (EXPLAIN STRUC)))
EXPR)

(DEFPROP EXPLAINATTACHBIVALENTS
 (LAMBDA(BVP STRUC)
  (ABOVE (PRINCL (FOR NEW PR IN BVP WHEN (NOT (ZEROP (CAR PR))) LIST (CONS (BIVLIST (CAR PR)) (CDR PR))))
	 (EXPLAIN STRUC)))
EXPR)

(DEFPROP EXPLAINATTACHBIVS&LOOPS
 (LAMBDA(BVP STRUC)
  (ABOVE (PRINCL (FOR NEW PR IN BVP WHEN (NOT (ZEROP (CAR PR))) LIST (CONS (BIVLIST (CAR PR)) (CDR PR))))
	 (EXPLAIN STRUC)))
EXPR)